home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Demo / IconCache.p < prev    next >
Text File  |  1997-07-19  |  2KB  |  127 lines
  1. UNIT IconCache;
  2. INTERFACE
  3.  
  4.     USES
  5.         Types, Memory, Icons;
  6.  
  7.     FUNCTION GetCachedIcon(iconID: INTEGER): CIconHandle;
  8.     PROCEDURE PlotCachedIcon(iconID: INTEGER; box: Rect);
  9.     PROCEDURE EmptyIconCache;
  10.  
  11. IMPLEMENTATION
  12.  
  13.     TYPE
  14.         IconCacheHandle = ^^IconCacheRec;
  15.         IconCacheRec = RECORD
  16.             icon: CIconHandle;
  17.             iconID: INTEGER;
  18.             next: IconCacheHandle;
  19.         END;
  20.         
  21.     VAR
  22.         cacheHead: IconCacheHandle;
  23.         
  24.     FUNCTION FindCachedIcon(iconID: INTEGER): IconCacheHandle;
  25.     VAR
  26.         icon: IconCacheHandle;
  27.         
  28.     BEGIN
  29.         icon := cacheHead;
  30.         WHILE (icon <> NIL) & (icon^^.iconID <> iconID) DO
  31.             icon := icon^^.next;
  32.         FindCachedIcon := icon;
  33.     END;
  34.     
  35.     FUNCTION AllocateIcon(iconID: INTEGER): IconCacheHandle;
  36.     VAR
  37.         icon: IconCacheHandle;
  38.         
  39.     BEGIN
  40.         Handle(icon) := NewHandleClear(SizeOf(IconCacheRec));
  41.         IF icon <> NIL THEN
  42.             BEGIN
  43.                 icon^^.icon := GetCIcon(iconID);
  44.                 IF icon^^.icon <> NIL THEN
  45.                     BEGIN
  46.                         HNoPurge(Handle(icon^^.icon));
  47.                         icon^^.iconID := iconID;
  48.                         icon^^.next := cacheHead;
  49.                         cacheHead := icon;
  50.                     END
  51.                 ELSE
  52.                     BEGIN
  53.                         DisposeHandle(Handle(icon));
  54.                         icon := NIL;
  55.                     END;
  56.             END;
  57.             
  58.         AllocateIcon := icon;
  59.     END;
  60.     
  61.     FUNCTION GetCachedIcon(iconID: INTEGER): CIconHandle;
  62.     VAR
  63.         icon: IconCacheHandle;
  64.         
  65.     BEGIN
  66.         icon := FindCachedIcon(iconID);
  67.         IF icon = NIL THEN
  68.             icon := AllocateIcon(iconID);
  69.             
  70.         IF icon = NIL THEN
  71.             GetCachedIcon := NIL
  72.         ELSE
  73.             GetCachedIcon := icon^^.icon;    
  74.     END;
  75.     
  76.     PROCEDURE CenterRect (box1, box2: Rect; VAR box3: Rect);
  77.     VAR
  78.         w1, w2: INTEGER;
  79.         h1, h2: INTEGER;
  80.  
  81.     BEGIN
  82.         w1 := box1.right - box1.left;
  83.         h1 := box1.bottom - box1.top;
  84.         
  85.         w2 := box2.right - box2.left;
  86.         h2 := box2.bottom - box2.top;
  87.         
  88.         box3.top := box1.top + h1 DIV 2 - h2 DIV 2;
  89.         box3.left := box1.left + w1 DIV 2 - w2 DIV 2;
  90.         box3.bottom := box3.top + h2;
  91.         box3.right := box3.left + w2;
  92.     END;
  93.  
  94.     PROCEDURE PlotCachedIcon(iconID: INTEGER; box: Rect);
  95.     VAR
  96.         icon: CIconHandle;
  97.         
  98.     BEGIN
  99.         icon := GetCachedIcon(iconID);
  100.         
  101.         IF icon <> NIL THEN
  102.             BEGIN
  103.                 CenterRect(box, icon^^.iconPMap.bounds, box);
  104.                 PlotCIcon(box, icon);
  105.             END;
  106.     END;
  107.     
  108.     PROCEDURE EmptyIconCache;
  109.     VAR
  110.         icon1, icon2: IconCacheHandle;
  111.         
  112.     BEGIN
  113.         icon1 := cacheHead;
  114.         WHILE (icon1 <> NIL) DO
  115.             BEGIN
  116.                 icon2 := icon1;
  117.                 icon1 := icon1^^.next;
  118.                 
  119.                 IF icon2^^.icon <> NIL THEN
  120.                     DisposeCIcon(icon2^^.icon);
  121.                 DisposePtr(Ptr(icon2));
  122.             END;
  123.             
  124.         cacheHead := NIL;
  125.     END;
  126.  
  127. END.